{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Test.Pos.Crypto.Bi
    ( constantByteString
    , exampleProtocolMagic
    , getBytes
    , tests
    ) where

import           Universum

import           Cardano.Crypto.Wallet (XPrv, unXPrv, xprv, xpub)

import           Crypto.Hash (Blake2b_224, Blake2b_256, Blake2b_384,
                     Blake2b_512, SHA1)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as BS
import           Data.List.NonEmpty (fromList)

import           Hedgehog (Gen, Property)
import qualified Hedgehog as H

import           Pos.Binary.Class (Bi)
import           Pos.Crypto (AbstractHash, EncShare, PassPhrase,
                     ProtocolMagic (..), ProtocolMagicId (..), PublicKey (..),
                     RequiresNetworkMagic (..), SafeSigner (FakeSigner),
                     Secret, SecretKey (..), SecretProof,
                     SignTag (SignForTestingOnly), VssKeyPair, WithHash,
                     decryptShare, deriveHDPassphrase, deterministic,
                     deterministicVssKeyGen, genSharedSecret, hash, mkSigned,
                     noPassEncrypt, packHDAddressAttr, proxySign,
                     redeemDeterministicKeyGen, redeemSign,
                     safeCreateProxyCert, safeCreatePsk, sign, toPublic,
                     toVssPublicKey)

import           Test.Pos.Binary.Helpers (SizeTestConfig (..), scfg, sizeTest)
import           Test.Pos.Binary.Helpers.GoldenRoundTrip (goldenTestBi,
                     roundTripsBiBuildable, roundTripsBiShow)
import           Test.Pos.Crypto.Gen
import           Test.Pos.Util.Golden (discoverGolden, eachOf)
import           Test.Pos.Util.Tripping (discoverRoundTrip)

--------------------------------------------------------------------------------
-- PublicKey
--------------------------------------------------------------------------------

golden_PublicKey :: Property
golden_PublicKey = goldenTestBi pkey "test/golden/PublicKey"
    where Right pkey = PublicKey <$> xpub (getBytes 0 64)

roundTripPublicKeyBi :: Property
roundTripPublicKeyBi = eachOf 1000 genPublicKey roundTripsBiBuildable

--------------------------------------------------------------------------------
-- SecretKey
--------------------------------------------------------------------------------

golden_SecretKey :: Property
golden_SecretKey = goldenTestBi skey "test/golden/SecretKey"
    where Right skey = SecretKey <$> xprv (getBytes 10 128)

roundTripSecretKeyBi :: Property
roundTripSecretKeyBi = eachOf 1000 genSecretKey roundTripsBiBuildable

--------------------------------------------------------------------------------
-- Signature
--------------------------------------------------------------------------------

golden_Signature :: Property
golden_Signature = goldenTestBi sig "test/golden/Signature"
  where
    Right skey = SecretKey <$> xprv (getBytes 10 128)
    sig        = sign exampleProtocolMagic SignForTestingOnly skey ()

roundTripSignatureBi :: Property
roundTripSignatureBi = eachOf 1000 genUnitSignature roundTripsBiBuildable

--------------------------------------------------------------------------------
-- Signed
--------------------------------------------------------------------------------

golden_Signed :: Property
golden_Signed = goldenTestBi signed "test/golden/Signed"
  where
    Right skey = SecretKey <$> xprv (getBytes 10 128)
    signed     = mkSigned exampleProtocolMagic SignForTestingOnly skey ()

roundTripSignedBi :: Property
roundTripSignedBi = eachOf 1000 genUnitSigned roundTripsBiShow
    where genUnitSigned = genSigned (pure ())

--------------------------------------------------------------------------------
-- EncryptedSecretKey
--------------------------------------------------------------------------------

-- | This instance is unsafe, as it allows a timing attack. But it's OK for
-- tests.
instance Eq XPrv where
   (==) = (==) `on` unXPrv

golden_EncryptedSecretKey :: Property
golden_EncryptedSecretKey = goldenTestBi esk "test/golden/EncryptedSecretKey"
    where Right esk = noPassEncrypt . SecretKey <$> xprv (getBytes 10 128)

roundTripEncryptedSecretKeysBi :: Property
roundTripEncryptedSecretKeysBi =
    eachOf 100 genEncryptedSecretKey roundTripsBiBuildable

--------------------------------------------------------------------------------
-- RedeemPublicKey
--------------------------------------------------------------------------------

golden_RedeemPublicKey :: Property
golden_RedeemPublicKey = goldenTestBi rpk "test/golden/RedeemPublicKey"
    where Just rpk = fst <$> redeemDeterministicKeyGen (getBytes 0 32)

roundTripRedeemPublicKeyBi :: Property
roundTripRedeemPublicKeyBi =
    eachOf 1000 genRedeemPublicKey roundTripsBiBuildable

--------------------------------------------------------------------------------
-- RedeemSecretKey
--------------------------------------------------------------------------------

golden_RedeemSecretKey :: Property
golden_RedeemSecretKey = goldenTestBi rsk "test/golden/RedeemSecretKey"
    where Just rsk = snd <$> redeemDeterministicKeyGen (getBytes 0 32)

roundTripRedeemSecretKeyBi :: Property
roundTripRedeemSecretKeyBi =
    eachOf 1000 genRedeemSecretKey roundTripsBiBuildable

--------------------------------------------------------------------------------
-- RedeemSignature
--------------------------------------------------------------------------------

golden_RedeemSignature :: Property
golden_RedeemSignature = goldenTestBi rsig "test/golden/RedeemSignature"
  where
    Just rsk = snd <$> redeemDeterministicKeyGen (getBytes 0 32)
    rsig     = redeemSign exampleProtocolMagic SignForTestingOnly rsk ()

roundTripRedeemSignatureBi :: Property
roundTripRedeemSignatureBi =
    eachOf 1000 genUnitRedeemSignature roundTripsBiBuildable

--------------------------------------------------------------------------------
-- VssPublicKey
--------------------------------------------------------------------------------

golden_VssPublicKey :: Property
golden_VssPublicKey = goldenTestBi vpk "test/golden/VssPublicKey"
    where vpk = toVssPublicKey . deterministicVssKeyGen $ getBytes 0 32

roundTripVssPublicKeyBi :: Property
roundTripVssPublicKeyBi = eachOf 1000 genVssPublicKey roundTripsBiShow

--------------------------------------------------------------------------------
-- ProxyCert
--------------------------------------------------------------------------------

golden_ProxyCert :: Property
golden_ProxyCert = goldenTestBi pcert "test/golden/ProxyCert"
  where
    Right pkey = PublicKey <$> xpub (getBytes 0 64)
    Right skey = SecretKey <$> xprv (getBytes 10 128)
    pcert      = safeCreateProxyCert exampleProtocolMagic (FakeSigner skey) pkey ()

roundTripProxyCertBi :: Property
roundTripProxyCertBi = eachOf 100 genUnitProxyCert roundTripsBiBuildable

--------------------------------------------------------------------------------
-- ProxySecretKey
--------------------------------------------------------------------------------

golden_ProxySecretKey :: Property
golden_ProxySecretKey = goldenTestBi psk "test/golden/ProxySecretKey"
  where
    Right pkey = PublicKey <$> xpub (getBytes 0 64)
    Right skey = SecretKey <$> xprv (getBytes 10 128)
    psk        = safeCreatePsk exampleProtocolMagic (FakeSigner skey) pkey ()

roundTripProxySecretKeyBi :: Property
roundTripProxySecretKeyBi =
    eachOf 100 genUnitProxySecretKey roundTripsBiBuildable

--------------------------------------------------------------------------------
-- ProxySignature
--------------------------------------------------------------------------------

golden_ProxySignature :: Property
golden_ProxySignature = goldenTestBi psig "test/golden/ProxySignature"
  where
    Right skey = SecretKey <$> xprv (getBytes 10 128)
    psk = safeCreatePsk exampleProtocolMagic (FakeSigner skey) (toPublic skey) ()
    psig = proxySign exampleProtocolMagic SignForTestingOnly skey psk ()

roundTripProxySignatureBi :: Property
roundTripProxySignatureBi = eachOf 100
                                   genUnitProxySignature
                                   roundTripsBiBuildable

--------------------------------------------------------------------------------
-- SharedSecretData
--------------------------------------------------------------------------------

sharedSecretData :: (Secret, SecretProof, [(VssKeyPair, EncShare)])
sharedSecretData = (s, sp, ys)
  where
    vssKeyPairs =
        [ deterministicVssKeyGen $ getBytes 0 32
        , deterministicVssKeyGen $ getBytes 32 32
        , deterministicVssKeyGen $ getBytes 64 32
        , deterministicVssKeyGen $ getBytes 96 32
        ]
    vssPublicKeys = map toVssPublicKey vssKeyPairs
    (s, sp, xs) =
        deterministic "ss" $ genSharedSecret 2 (fromList vssPublicKeys)
    ys = zipWith (\(_, y) x -> (x, y)) xs vssKeyPairs

--------------------------------------------------------------------------------
-- DecShare
--------------------------------------------------------------------------------

golden_DecShare :: Property
golden_DecShare = goldenTestBi decShare "test/golden/DecShare"
  where
    Just decShare = case sharedSecretData of
        (_, _, xs) -> deterministic "ds" . uncurry decryptShare <$> fmap fst (uncons xs)

roundTripDecShareBi :: Property
roundTripDecShareBi = eachOf 20 genDecShare roundTripsBiShow

--------------------------------------------------------------------------------
-- EncShare
--------------------------------------------------------------------------------

golden_EncShare :: Property
golden_EncShare = goldenTestBi encShare "test/golden/EncShare"
  where
    Just encShare = case sharedSecretData of
        (_, _, xs) -> snd <$> fmap fst (uncons xs)

roundTripEncShareBi :: Property
roundTripEncShareBi = eachOf 20 genEncShare roundTripsBiShow

--------------------------------------------------------------------------------
-- Secret
--------------------------------------------------------------------------------

golden_Secret :: Property
golden_Secret = goldenTestBi secret "test/golden/Secret"
  where
    secret = case sharedSecretData of
        (s, _, _) -> s

roundTripSecretBi :: Property
roundTripSecretBi = eachOf 20 genSecret roundTripsBiShow

--------------------------------------------------------------------------------
-- SecretProof
--------------------------------------------------------------------------------

golden_SecretProof :: Property
golden_SecretProof = goldenTestBi secretProof "test/golden/SecretProof"
  where
    secretProof = case sharedSecretData of
        (_, sp, _) -> sp

roundTripSecretProofBi :: Property
roundTripSecretProofBi = eachOf 20 genSecretProof roundTripsBiShow

--------------------------------------------------------------------------------
-- AbstractHash
--------------------------------------------------------------------------------

golden_AbstractHash :: Property
golden_AbstractHash = goldenTestBi (hash ()) "test/golden/AbstractHash"

roundTripAbstractHashBi :: Property
roundTripAbstractHashBi = eachOf 1000 genUnitAbstractHash roundTripsBiBuildable

--------------------------------------------------------------------------------
-- WithHash
--------------------------------------------------------------------------------

golden_WithHash :: Property
golden_WithHash = goldenTestBi (hash ()) "test/golden/WithHash"

genUnitWithHash :: Gen (WithHash ())
genUnitWithHash = genWithHash $ pure ()

roundTripWithHashBi :: Property
roundTripWithHashBi = eachOf 1000 genUnitWithHash roundTripsBiBuildable

--------------------------------------------------------------------------------
-- PassPhrase
--------------------------------------------------------------------------------

golden_PassPhrase :: Property
golden_PassPhrase = goldenTestBi passphrase "test/golden/PassPhrase"
    where
    -- PassPhrase has to be 32 bytes in length
          passphrase = ByteArray.pack (BS.unpack $ getBytes 3 32) :: PassPhrase

roundTripPassPhraseBi :: Property
roundTripPassPhraseBi = eachOf 1000 genPassPhrase roundTripsBiBuildable

--------------------------------------------------------------------------------
-- HDAddressPayload
--------------------------------------------------------------------------------

golden_HDAddressPayload :: Property
golden_HDAddressPayload = goldenTestBi hdap "test/golden/HDAddressPayload"
  where
    Right hdap =
        flip packHDAddressAttr [] . deriveHDPassphrase . PublicKey <$> xpub
            (getBytes 0 64)

roundTripHDAddressPayloadBi :: Property
roundTripHDAddressPayloadBi = eachOf 1000 genHDAddressPayload roundTripsBiShow

--------------------------------------------------------------------------------

getBytes :: Int -> Int -> ByteString
getBytes offset len = BS.take len $ BS.drop offset constantByteString

-- | Changing existing values in this string will break existing golden
-- tests, but it us OK to append more data to the end.
constantByteString :: ByteString
constantByteString
    = "Kmyw4lDSE5S4fSH6etNouiXezCyEjKc3tG4ja0kFjO8qzai26ZMPUEJfEy15ox5kJ0uKD\
    \bi7i6dLXkuesVZ9JfHgjrctsLFt2NvovXnchsOvX05Y6LohlTNt5mkPFhUoXu1EZSJTIy\
    \3fTU53b412r4AEusD7tcdRgH47yTr5hMO63bJnYBbmNperLHfiT1lP0MLQLh1J1DfoYBs\
    \auoJOzvtAgvjHo6UFttnK6vZ3Cknpuob6uMS2MkJKmuoQsqsAYcRDWbJ2Rgw4bm2ndTM4\
    \zFfuRDKvdrL6sDkuPNPYqxMWlqnXjSbU0eLtceZuKgXLHR8cdvsEvywt4JaZUQhnbq3Vl\
    \7nZqcXdoi4XGTCgSGcGp8N0SDVhvkVh0QF1RVpWPnOMyYISJvuaHfo1zXMdq9tEdtJfID"

exampleProtocolMagic :: ProtocolMagic
exampleProtocolMagic = ProtocolMagic (ProtocolMagicId 0) RequiresNoMagic

--------------------------------------------------------------------------------

sizeEstimates :: H.Group
sizeEstimates = let check :: forall a. (Show a, Bi a) => Gen a -> Property
                    check g = sizeTest $ scfg { gen = g, precise = True } in
    H.Group "Encoded size bounds for crypto types."
        [ ("PublicKey"         , check genPublicKey)
        , ("WithHash PublicKey", check $ genWithHash genPublicKey)
        , ("AbstractHash Blake2b_224 PublicKey",
           check @(AbstractHash Blake2b_224 PublicKey) $ genAbstractHash genPublicKey)
        , ("AbstractHash Blake2b_256 PublicKey",
           check @(AbstractHash Blake2b_256 PublicKey) $ genAbstractHash genPublicKey)
        , ("AbstractHash Blake2b_384 PublicKey",
           check @(AbstractHash Blake2b_384 PublicKey) $ genAbstractHash genPublicKey)
        , ("AbstractHash Blake2b_512 PublicKey",
           check @(AbstractHash Blake2b_512 PublicKey) $ genAbstractHash genPublicKey)
        , ("AbstractHash SHA1 PublicKey",
           check @(AbstractHash SHA1 PublicKey) $ genAbstractHash genPublicKey)
        , ("RedeemPublicKey", check genRedeemPublicKey)
        , ("RedeemSecretKey", check genRedeemSecretKey)
        , ("RedeemSignature PublicKey", check (genRedeemSignature exampleProtocolMagic genPublicKey))
        ]

--------------------------------------------------------------------------------

tests :: IO Bool
tests = and <$> sequence
    [ H.checkSequential $$discoverGolden
    , H.checkSequential $$discoverRoundTrip
    , H.checkParallel sizeEstimates
    ]
